home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbbug.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-03  |  4.4 KB  |  198 lines
  1. (*===========================================================================*)
  2. (* Debugging programs                                                        *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1990, 1991, 1992 by H. Roy Engehausen.  All       *)
  5. (*   rights reserved.                                                        *)
  6. (*                                                                           *)
  7. (*===========================================================================*)
  8.  
  9. {$O+}
  10.  
  11. UNIT BBBUG;
  12.  
  13. INTERFACE
  14.  
  15.   USES bbdummy;
  16.  
  17.   FUNCTION  c2x(instr : STRING) : STRING;
  18.   FUNCTION  b2x(inb : BYTE) : str2;
  19.   FUNCTION  w2x(inw : WORD) : str8;
  20.   FUNCTION  a2x(inw : WORD) : str8;
  21.   FUNCTION  p2x(inp : POINTER) : str15;
  22.   FUNCTION  pw2x(inw1, inw2 : WORD) : str15;
  23.   FUNCTION  l2c(inl : LONGINT) : str8;
  24.   PROCEDURE semaphore_bug (sem_num : BYTE; halt_system : BOOLEAN);
  25.  
  26. (*---------------------------------------------------------------------------*)
  27. (* Ok!  Let's start work.                                                    *)
  28. (*---------------------------------------------------------------------------*)
  29.  
  30. IMPLEMENTATION
  31.  
  32. USES
  33.   CRT,
  34.   bbdump,
  35.   bbstr;
  36.  
  37. (*===========================================================================*)
  38. (* Convert an incoming string to hexidecimal characters                      *)
  39. (*===========================================================================*)
  40.  
  41. FUNCTION c2x(instr : STRING) : STRING;
  42.   VAR
  43.     i : BYTE;
  44.     j : BYTE;
  45.     k : BYTE;
  46.     out : STRING;
  47.  
  48.   BEGIN;
  49.  
  50.     i   := 0;
  51.     out := '';
  52.  
  53.     WHILE (i < LENGTH(instr)) DO
  54.       BEGIN;
  55.         i := i + 1;
  56.         j := ORD(instr[i]);
  57.  
  58.         out[2*i-1] := byte_to_char[j SHR 4];
  59.         out[2*i  ] := byte_to_char[j AND $0F];
  60.  
  61.       END;
  62.  
  63.     out[0] := CHR(2*i);
  64.  
  65.     c2x := out;
  66.  
  67.   END;
  68.  
  69.   FUNCTION b2x(inb : BYTE) : str2;
  70.  
  71.     VAR
  72.       out : STRING[2];
  73.  
  74.     BEGIN;
  75.  
  76.       out[0] := CHR(2);
  77.       out[1] := byte_to_char[inb SHR 4];
  78.       out[2] := byte_to_char[inb AND $0F];
  79.  
  80.       b2x := out;
  81.  
  82.     END;
  83.  
  84.   FUNCTION w2x(inw : word) : str8;
  85.     VAR
  86.       i : BYTE;
  87.       j : BYTE;
  88.       k : BYTE;
  89.       instr : STRING[2];
  90.       out : str8;
  91.  
  92.     BEGIN;
  93.  
  94.       instr[0] := CHR(2);
  95.       instr[1] := CHR(HI(inw));
  96.       instr[2] := CHR(LO(inw));
  97.  
  98.       i   := 0;
  99.       out := '';
  100.  
  101.       WHILE (i < LENGTH(instr)) DO
  102.         BEGIN;
  103.           i := i + 1;
  104.           j := ORD(instr[i]);
  105.  
  106.           out[2*i-1] := byte_to_char[j SHR 4];
  107.           out[2*i  ] := byte_to_char[j AND $0F];
  108.  
  109.         END;
  110.  
  111.       out[0] := CHR(2*i);
  112.  
  113.       w2x := out;
  114.  
  115.     END;
  116.  
  117.   FUNCTION a2x(inw : word) : str8;
  118.     VAR
  119.       i : BYTE;
  120.       j : BYTE;
  121.       k : BYTE;
  122.       instr : STRING[2];
  123.       out : str8;
  124.  
  125.     BEGIN;
  126.  
  127.       instr[0] := CHR(2);
  128.       instr[1] := CHR(HI(inw));
  129.       instr[2] := CHR(LO(inw));
  130.  
  131.       i   := 0;
  132.       out := '';
  133.  
  134.       WHILE (i < LENGTH(instr)) DO
  135.         BEGIN;
  136.           i := i + 1;
  137.           j := ORD(instr[i]);
  138.           k := j SHR 4;
  139.  
  140.           out[2*i-1] := byte_to_char[j SHR 4];
  141.           out[2*i  ] := byte_to_char[j AND $0F];
  142.  
  143.         END;
  144.  
  145.       out[0] := CHR(2*i);
  146.  
  147.       a2x := out;
  148.  
  149.     END;
  150.  
  151.   FUNCTION  p2x(inp : POINTER) : str15;
  152.     BEGIN;
  153.       p2x := a2x(SEG(inp^)) + ':' + a2x(OFS(inp^));
  154.     END;
  155.  
  156.   FUNCTION  pw2x(inw1, inw2 : WORD) : str15;
  157.     BEGIN;
  158.       pw2x := a2x(inw1) + ':' + a2x(inw2);
  159.     END;
  160.  
  161.   FUNCTION l2c(inl : LONGINT) : str8;
  162.     VAR
  163.       s : str8;
  164.       x : ARRAY[1..4] OF BYTE;
  165.     BEGIN;
  166.       MOVE(inl, x, 4);
  167.       s :=     b2x(x[1]);
  168.       s := s + b2x(x[2]);
  169.       s := s + b2x(x[3]);
  170.       s := s + b2x(x[4]);
  171.       l2c := s;
  172.     END;
  173.  
  174. (*===========================================================================*)
  175. (* Semaphore bug detected                                                    *)
  176. (*===========================================================================*)
  177.  
  178. PROCEDURE semaphore_bug (sem_num : BYTE; halt_system : BOOLEAN);
  179.  
  180.   BEGIN;
  181.  
  182.     WRITELN('Semaphore bug!!!');
  183.  
  184.     dump_reason('Semaphore # ' + w2c(sem_num));
  185.  
  186.     WITH active_tcb^ DO
  187.       dump_reason('Active = ' + w2c(tcb_number) + ' ' + tcb_name + ' '
  188.                         + port_chan_s);
  189.  
  190.     dump_semaphores;
  191.  
  192.     IF halt_system THEN
  193.       HALT;
  194.  
  195.   END;
  196.  
  197. END.
  198.